The Customer`s Medical Heart Rate Monitoring System comprises of the following components.
A heart rate variability monitor strapped to the patient`s chest.Acute Patients are immobilized in the ICU.
A wireless reciver subsytem is installed in the montoring room 30ft away from the bedside.The equipment vendor supplied the equipment 5 years ago, tested and verified that the transmitted R-R intervals would display on the monitoring station.
A mobile App enhanced to provide mobile monitoring capabilities.
Simulated Link.
The simulated link is built to allow collection of open source bluetooth link logs.
..
The business technical goals and trade offs were considered in characterizing the system.The AIC Triad were the most pertinent for the user.It is a venerable method used for analysing end to end network performance.
library(plotly)
library(stats)
library(tidyr)
library(epitools)
library(prettyR)
library(plotrix)
library(ggplot2)
library(reshape2)
library(dplyr)
library(MASS)
library(VIM)
#library(mice)
library(data.table)
library(stringi)
library(stringr)
library(RColorBrewer)
library(DBI)
library(e1071)
library(tidyverse)
library(pastecs)
library(ggpubr)
library(rstatix)
library(car)
library(modeest)
library(DT)
library(expss)
#library(rlist)
library(gdata)
library(lubridate)
library(dbplyr)
library(Hmisc)
library(sqldf)
library(broman)
library(univOutl)
library(ggstatsplot)
library(fitdistrplus)
library(WeibullR)
library(tolerance)
#library(bigmemory)
#library( REdaS)
library(changepoint)
library(inflection)
library(ggpmisc)
library(DescTools)Returns: Dataframe of the dataset imported from sdl.medicalclaims table Msc database
#dt_Bt_Link <- read.csv2("bt_Link_kpi_1.csv", header=TRUE, sep=",")
#setwd("C:/Users/narhuidese/Desktop/USF/HS631_lectures")
dt_Bt_Link <- read.csv2("./data/bt_Link_kpi_1.csv", header=TRUE, sep=",")
#head(as.data.frame(dt_Bt_Link),n = 10)
datatable(head(dt_Bt_Link,20), rownames = TRUE, options = list(autoWidth = TRUE,pageLength = 7, scrollX=T),caption = 'Table 1: Aggregate link dataset' )#head(dt_Bt_Link,10)# datatable(head(dt_Bt_Link,20), rownames = TRUE, options = list(autoWidth = TRUE,pageLength = 7, scrollX=T),caption = 'Table 1: Aggregate link dataset' )#str(dt_Bt_Link)
#dt_unique <- unique(dt_Emh)
#nrow(dt_unique)
#rm(dt_unique)
dt_Bt_Link_1 <- dt_Bt_LinkRestructure the datatypes
dt_Bt_Link_1$BT_MAC_Throughput_DL.1 <- as.numeric(as.character(dt_Bt_Link_1$BT_MAC_Throughput_DL.1))
dt_Bt_Link_1$Tx_Power_.dBm._class.2 <- as.numeric(as.character(dt_Bt_Link_1$Tx_Power_.dBm._class.2 )) #as.numeric(as.character(x))
dt_Bt_Link_1$Rx.Power..dBm. <- as.numeric(as.character(dt_Bt_Link_1$Rx.Power..dBm.))
dt_Bt_Link_1$Physical_Layer.PHY. <- as.character(dt_Bt_Link_1$Physical_Layer.PHY. )
dt_Bt_Link_1$Link_Margin <- as.numeric(as.character(dt_Bt_Link_1$Link_Margin))
dt_Bt_Link_1$Signal_to_Noise_Ratio <- as.numeric(as.character(dt_Bt_Link_1$Signal_to_Noise_Ratio ))
dt_Bt_Link_1$Max_number_of_retransmission <- as.factor(dt_Bt_Link_1$Max_number_of_retransmission)Returns: Change structure of the data variables
#str(dt_Bt_Link_1)
#str(dt_Emh1)#head(dt_Bt_Link_1,50)Check for NA`S
any(is.na(dt_Bt_Link_1))## [1] FALSE
Availability is dependent on uptime & downtime that may be due to any to possible equipment outage,power failure or fading.The link was designed to be a high reliability link of “five nines”.
Availability Metric: Mean time between failure. MTBF/(MTBF+MTTR) * The receiver must have a sensitivity level for which the bit error rate (BER) 0.1% is met.
Distribution of Rx Lev at the input of the receiver detector. Create group variable for link performance. Categorize RXlev by noise floor
#if RxLev > Sensitivity + link margin threshold = Uptime
#if link margin threshold > Rxlev & Rxlev > Sensitivity = danger zone
#if RxLev < sensitivity = unintelligible transmission.
#Categorize the RXlev by noise floor into 2 groups
dt_Bt_Link_1$RxLev_cat[dt_Bt_Link_1$Rx.Power..dBm. > (dt_Bt_Link_1$Rx_Sensitivity_.dBm)] = "Uptime"
dt_Bt_Link_1$RxLev_cat[dt_Bt_Link_1$Rx.Power..dBm. <= (dt_Bt_Link_1$Rx_Sensitivity_.dBm.)] = "Downtime"#Categorize the Sensitivity into two groups
dt_Bt_Link_1$Sensitivity_cat[dt_Bt_Link_1$Rx_Sensitivity_.dBm. > -90] = "Sensitivity_drop"
dt_Bt_Link_1$Sensitivity_cat[dt_Bt_Link_1$Rx_Sensitivity_.dBm. <= -90]= "Sensitivity_normal"#head(dt_Bt_Link_1)table(dt_Bt_Link_1$RxLev_cat)##
## Downtime Uptime
## 9 3727
Pie chart of performance of the Link
Returns: Frequency table of link performance
sort(table(dt_Bt_Link_1$RxLev_cat))##
## Downtime Uptime
## 9 3727
Av <- as.data.frame(table(dt_Bt_Link_1$RxLev_cat))___Returns: Plot of distribution of availability.
p<- ggplot(Av, aes(x="Link Availability", y=Freq, fill=Var1))+
geom_bar(width = 1, stat = "identity")
pie1 <- p + coord_polar("y", start=0)
pie1Fig 1:Frequency distribution of the denominator physicians
#Availabilty = Uptime/(uptime + downtime)
Availability = (Av$Freq[2]/(Av$Freq[2]+Av$Freq[1]))*100
Availability## [1] 99.7591
Returns: .Number of times that Rxlev was at the certain value._ The confidence interval shown for the system parameter bellow assumes normal distribution. 95% confidence interval of the RxLev is the range that contains the true value of the estimated parameter.
# for reproducibility
set.seed(123)
# plot
histmr <- gghistostats(
data = dt_Bt_Link_1,
x = Rx.Power..dBm.,
binwidth = 0.6,
#y=stat(count)/sum(stat(count)),
normal.curve = TRUE, # superimpose a normal distribution curve
normal.curve.args = list(color = "red", size = 1),
conf.level = 0.95,
bar.measure = "proportion",
k=2,
#type ="nonparametric",
type = "robust",
robust.estimator ="mom",
#bar.fill = "green",
bin.args = list(color = "black", fill = "#0088B1FF", alpha = 0.7),
#ggtheme = ggstatsplot::theme_ggstatsplot(),
ggtheme = ggplot2::theme_gray(),
ggplot.component = list(theme(axis.text = element_text(colour = "blue"),text = element_text(size=15),plot.title = element_text(color = "red", size = 14, face = "bold"),plot.subtitle = element_text(color = "blue",size = 12)),
ylab("Percentage of time"), xlab("Rx Power Level "),ggtitle(labs(title = "Distribution of RxLev"))),
messages = FALSE
)
histmr Fig 9:Histogram of measure rate with summary stats
# p + theme(
# plot.title = element_text(color = "red", size = 12, face = "bold"),
# plot.subtitle = element_text(color = "blue"),
# plot.caption = element_text(color = "green", face = "italic")
# )#dt_IMgn1$MarketScan_Specialty <- vlookup(dt_IMgn1$ProviderNPI,dt_phy_spec,result_column = 2,lookup_column = 1)
#head(dt_Aih1)
#dt_Emh1$MarketScan_Specialty <- vlookup(dt_Emh1$ProviderNPI,dt_phy_spec,result_column = 2,lookup_column = 1)
#head(dt_Emh1)
#str(dt_IMgn1)Returns: Probability Density of RxLev grouped by avaialbility Which rxLev value contribute the most to avaialability?
#age by mortality
Densityplot <- ggplot(data = dt_Bt_Link_1,aes(x=Rx.Power..dBm.,fill=RxLev_cat))+
geom_density(alpha = 0.7,cex=1)+ggtitle(labs(title = "Distribution of RxLev grouped by Availability"))+theme(text = element_text(size=10))
Densityplot Returns: Distribution of Receive level by avaialbility
#INR value grouped by icd9 categories
Histogram2 <- ggplot(data = dt_Bt_Link_1,aes(x=Rx.Power..dBm.,fill=RxLev_cat))+
geom_histogram(alpha = 0.7,binwidth = .8,cex = 6,position = "dodge")+ggtitle(labs(title = "Histogram of Rxlev grouped by availability"))+theme(text = element_text(size=10))
Histogram2Returns: Plot of sensitivity by availability
#INR value grouped by icd9 categories
Histogram3 <- ggplot(data = dt_Bt_Link_1,aes(x=Rx_Sensitivity_.dBm.,fill=RxLev_cat))+
geom_histogram(alpha = 0.7,binwidth = .1,cex = 3,position = "dodge")+ggtitle(labs(title = "Histogram of Sensitivity grouped by Availability "))+theme(text = element_text(size=10))
Histogram3Histogram2Histogram3First summarise and transform your data:gender GROUPED BY rxlev cat ___Returns: A plot of the impact of sensitivity on the outage or downtime.
d4 <- dt_Bt_Link_1 %>%
group_by(Sensitivity_cat,RxLev_cat) %>%
summarise(count=n()) %>%
mutate(perc=count/sum(count))## `summarise()` has grouped output by 'Sensitivity_cat'. You can override using the `.groups` argument.
bar4 <- ggplot(data=d4, aes(x=Sensitivity_cat, y=perc, fill=RxLev_cat)) +
geom_bar(position = 'dodge', stat ='identity')+scale_y_continuous(labels = scales::percent)+labs(x = "Sensitivity", y = "Percentage of availability", fill = "Availability") + ggtitle(labs(title = "Device Sensitivity by availability"))+ theme(text = element_text(size=10))+ geom_text(aes(label = scales::percent(perc),y = perc),position=position_dodge(width=0.7), vjust = -0.25,size=3.5)
bar4 + facet_grid(. ~ Sensitivity_cat,scales='free')Throughput: Rx Device gauranteed throughput based on QOS - quality of service of the system. This system has a capacity of 2Mbps. As seen bellow,the through put is not consistent.
Returns: A plot of throughput delivered with respect to time
# Multiple line plot
ggplot(dt_Bt_Link_1, aes(x = Time_.sec., y = BT_MAC_Throughput_DL.1)) +
geom_line(aes(color = RxLev_cat), size = 1.5) + ggtitle(labs(title = "Bluetooth Device downlink throughput"))+ theme(text = element_text(size=10))Returns: Number of Descriptive Statistics of Receive Power.
Assumption: Normal distribtution because of the Central Limit theorem for large dataset where n >> 30
set.seed(1243)
x<-as.data.frame(stat.desc(dt_Bt_Link_1$Rx.Power..dBm., basic=TRUE, desc=TRUE, norm=TRUE, p=0.95))
x$`stat.desc(dt_Bt_Link_1$Rx.Power..dBm., basic = TRUE, desc = TRUE, norm = TRUE, p = 0.95)` <- round(x$`stat.desc(dt_Bt_Link_1$Rx.Power..dBm., basic = TRUE, desc = TRUE, norm = TRUE, p = 0.95)`, 2)
names(x)[1] <- "Value"
names(x)[0] <- "Sample Stats"
x| Value | |
|---|---|
| nbr.val | 3736.00 |
| nbr.null | 0.00 |
| nbr.na | 0.00 |
| min | -88.08 |
| max | -41.95 |
| range | 46.13 |
| sum | -286314.34 |
| median | -80.56 |
| mean | -76.64 |
| SE.mean | 0.16 |
| CI.mean.0.95 | 0.31 |
| var | 90.64 |
| std.dev | 9.52 |
| coef.var | -0.12 |
| skewness | 1.63 |
| skew.2SE | 20.39 |
| kurtosis | 1.90 |
| kurt.2SE | 11.86 |
| normtest.W | 0.76 |
| normtest.p | 0.00 |
Returns: Number of Physicians with denominator cases and numerator cases.
The BLE encryption protocol doesn`t is not shown in the wireshrk Bluettoth protocols. I have not seen it yet. Currently, the encryption scheme used for this link has not been identified.
For project use Project Presentation
Project